home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / flow / procom.for < prev    next >
Text File  |  1992-07-31  |  3KB  |  99 lines
  1.       SUBROUTINE PROCOM
  2. C! Produce the COMMON block table
  3.       INCLUDE 'params.h'
  4.       INCLUDE 'lunits.h'
  5.       INCLUDE 'trecom.h'
  6.       INCLUDE 'tables.h'
  7.       PARAMETER (LLINE=130,LOFF=10,MLINE=(LLINE-LOFF)/2,LPAGE=50)
  8.       CHARACTER*(LLINE) CLINE
  9.       CHARACTER*(LLINE+1) CTEMP
  10. C
  11.       CTEMP(:LOFF) = ' '
  12.       CTEMP(LOFF+1:LOFF+1) = '+'
  13.       DO 7 I=1,LLINE-LOFF-1
  14.         CTEMP(LOFF+1+I:LOFF+1+I) = '-'
  15.     7 CONTINUE
  16.       CTEMP(LLINE+1:LLINE+1) = '+'
  17. C
  18. C
  19.       WRITE(LOUT,'(A)') ' '
  20.       WRITE(LOUT,'(A)') ' PROCOM Begins ....'
  21.       WRITE(LOUT,'(A)') ' '
  22. C
  23. C write top page
  24. C
  25.       WRITE(LOUTCO,666)
  26.   666 FORMAT(1X,20('*'),'              ProCom             ',20('*'),
  27.      &     /,1X,20(' '),'              ======             ',20(' '),
  28.      &     ///,1X,20(' '),' Module names appear along x-axis',
  29.      &     /,1X,20(' '),' COMMON block names along y-axis',
  30.      &     /,
  31.      &     /,1X,20(' '),' <Y>  ==> COMMON used in module'
  32.      &     /,1X,20(' '),' <N>  ==> COMMON not used (but is DECLARED)',
  33.      &     /,1X,20(' '),' < >  ==> COMMON not DECLARED',
  34.      &     /,1X,20('*'),'*********************************',20('*'))
  35.       NPAGE = 0
  36.       NCOLS = 0
  37.     1 CONTINUE
  38.       IF(NPAGE*LPAGE/2.GE.NCOMM) GOTO 110
  39.     2 CONTINUE
  40.       IF(NCOLS.GE.NPROC) GOTO 100
  41. C
  42. C move to new page
  43. C
  44.       WRITE(LOUTCO,490)
  45.   490 FORMAT(1H1)
  46.       DO 5 ILET = 1,6
  47.         CLINE(:) = ' '
  48.         DO 10 IPRO=1,MIN(NPROC,MLINE)
  49.           IPRO1 = IPRO+NCOLS
  50.           IF(IPRO1.GT.NPROC) GOTO 11
  51.           IPOS = IPRO*2 + LOFF
  52.           IF(LENOCC(PROCED_NAME(IPRO1)).LT.ILET) THEN
  53.             CLINE(IPOS:IPOS) = ' '
  54.           ELSE
  55.             CLINE(IPOS:IPOS) = PROCED_NAME(IPRO1)(ILET:ILET)
  56.           ENDIF
  57.    10   CONTINUE
  58.    11   CONTINUE
  59.         WRITE(LOUTCO,'(A)') CLINE(:LLINE)
  60.     5 CONTINUE
  61. C
  62. C now loop over all common names
  63. C
  64.       WRITE(LOUTCO,'(A)') CTEMP(:LLINE)
  65.       DO 15 ICOM=1,MIN(NCOMM,LPAGE/2)
  66.         ICOM1 = ICOM+NPAGE*LPAGE/2
  67.         IF(ICOM1.GT.NCOMM) GOTO 16
  68.         CLINE = COMMON_NAME(ICOM1)
  69.         LINE = LENOCC(CLINE)
  70. C
  71. C now find procedures using this common
  72. C loop over them, constructing cline
  73. C
  74.         DO 20 IPROC=NCOLS+1,MIN(NCOLS+MLINE,NPROC)
  75.           IPOS1 = IPROC - NCOLS
  76.           IPOS = IPOS1*2 + LOFF -1
  77.           CLINE(IPOS:IPOS) = COMMON_USED(IPROC,ICOM)
  78.    20   CONTINUE
  79.         CLINE(10:10) = '|'
  80.         CLINE(LLINE:LLINE) = '|'
  81.         WRITE(LOUTCO,'(1X,A)') CLINE(:LLINE)
  82.         CLINE = ' '
  83.         CLINE(10:10) = '|'
  84.         CLINE(LLINE:LLINE) = '|'
  85. C       WRITE(LOUTCO,'(1X,A)') CLINE(:LLINE)
  86.    15 CONTINUE
  87.    16 CONTINUE
  88.       WRITE(LOUTCO,'(A)') CTEMP(:LLINE)
  89.    90 CONTINUE
  90.       NCOLS = NCOLS+MLINE
  91.       GOTO 2
  92.   100 CONTINUE
  93.       NPAGE = NPAGE+1
  94.       NCOLS = 0
  95.       GOTO 1
  96.   110 CONTINUE
  97.       WRITE(LOUT,'(A)') ' PROCOM Finished'
  98.       END
  99.